home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1995 August: Tool Chest / Dev.CD Aug 95 TC / Dev.CD Aug 95 TC.toast / Tool Chest / Development Tools & Languages / Dylan Related / Thomas / MacGambit⁄Thomas / MacGambit⁄Thomas Sources / Reference Notes / Template.scm < prev    next >
Encoding:
Text File  |  1995-03-15  |  2.3 KB  |  73 lines  |  [TEXT/gamI]
  1. ; ----------------------------------------------------------------------------
  2. ; File:        Template.scm
  3. ; Description: A window template function.
  4. ; Author:      Mike Brumbelow @ ART
  5. ; Created:     1-Oct-94
  6. ; Modified:    01-Jan-95
  7. ; Language:    Scheme
  8. ; Status:      Experimental (Swim at your own risk)
  9. ;
  10. ;          (c) Copyright 1994, Advanced Robotic Technologies, Inc.
  11. ;              All Rights Reserved.
  12. ;
  13. ; ----------------------------------------------------------------------------
  14.  
  15. (define (mike-view top left bottom right name var)
  16.   (let* ((rect (mac#rect top left bottom right))
  17.          (w (mac#newwindow rect name #t var -1 #t))
  18.          (wind 0)
  19.          (new-view (gensym)))
  20.  
  21.     (define (handle-keydown ch mods)
  22.       (case ch
  23.         ((#\c)
  24.          (mac#eraserect w (mac#rect -32000 -32000 32000 32000)))
  25.         ((#\q)
  26.          (mac#sysbeep 20)
  27.          (handle-goaway))
  28.         (else #t)))
  29.  
  30.     (define (handle-goaway)
  31.       (mac#window-unbind w)
  32.       (mac#disposewindow w))
  33.  
  34.     (define (mousedown pt modifiers) #t)
  35.     (define (mouseup pt modifiers)   #t)
  36.     (define (keydown ch modifiers)   (handle-keydown ch modifiers))
  37.     (define (keyup ch modifiers)     #t)
  38.     (define (autokey ch modifiers)   #t)
  39.     (define (goaway)                 (handle-goaway))
  40.     (define (update)                 #t)
  41.     (define (activate)               #t)
  42.     (define (deactivate)             #t)
  43.  
  44.    (define (wind msg)
  45.       (case msg
  46.         ((MOUSEDOWN)  mousedown)
  47.         ((MOUSEUP)    mouseup)
  48.         ((KEYDOWN)    keydown)
  49.         ((KEYUP)      keyup)
  50.         ((AUTOKEY)    autokey)
  51.         ((GOAWAY)     goaway)
  52.         ((UPDATE)     update)
  53.         ((ACTIVATE)   activate)
  54.         ((DEACTIVATE) deactivate)
  55.         (else         (error "Unknown window message:" msg))))
  56.  
  57.    (if (= w 0)
  58.       (error "Window could not be created (out of memory?)")
  59.       (begin
  60.         (mac#window-bind w wind)
  61.         (mac#setport w)
  62.         (put new-view 'window w)
  63.         (put new-view 'rect rect)
  64.         ))
  65.     new-view))
  66. ;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  67.  
  68.  
  69. (define (kill)                ;; A window killing function
  70.   (set! x (get test 'window)) ;; Use only when the window is hung-up
  71.   (mac#disposewindow x))      ;; Or when a function has gone hay-wire
  72.  
  73. (set! test (mike-view 50 40 400 500 "Type name of window here" 4))